perm filename FNDTRN.FRI[NEW,LCS] blob
sn#314569 filedate 1977-10-28 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE MNMX(IDIF,JRN)
C00017 ENDMK
Cā;
SUBROUTINE MNMX(IDIF,JRN)
DIMENSION JRN(1)
COMMON /MNX/MIN,MAX,JT
L=MIN
N=MAX
CALL MINMAX(JRN)
J=MAX-MIN
IF(J.LE.IDIF)GO TO 1
MIN=L
MAX=N
RETURN
1 IDIF=J
END
SUBROUTINE FNDTRN(RPG,PGTRN,JBAR,IBAR,KT,KB)
DIMENSION PGTRN(1),JBAR(1),IBAR(1)
COMMON /BRJ/JTOT,TURN,NB,DSK /STF/RSTFAC(0/7),RSTJ2
TYPE 20
ACCEPT 21,TURN
20 FORMAT(' TYPE TURN TIME UNIT '$)
21 FORMAT(F)
PGTRN(KT)=100
C LAST BAR ALWAYS GOOD FOR TURN (FOR AUTOMATIC SYSTEM)
IBAR(1)=0
IF(TURN.EQ.0)TURN=2
C WANTS HALF REST FOR TURN AT FIRST
RPG=JTOT/250.+.5
LPG=RPG
JP=RPG/(10.*RSTJ2)+.5
C JP= HOW MANY PAGES
P=LPG/JP
LT=1
11 AV=JTOT/RPG
AV2=2*AV
NTOT=JTOT
KB=1
NAV=P*AV/2.
C FOR MINIMUM LINES PER PAGE
MM=1
SPG=RPG
7 JAV=AV*P
J=0
DO 1 K=LT,KT
J=J+JBAR(K)
1 IF(J.GE.JAV)GO TO 2
C JUMP OUT WHEN JPAGE IS IDEALLY FULL
2 L=-1
C FOR FLIPFLOP
N=K
M=K
NN=J
JJ=J
3 IF(PGTRN(K).GE.TURN)GO TO 4
C JUMP IF TURN FOUND
IF(J.GE.NAV)GO TO 10
CHECK TO SEE IF TOO SMALL A PAGE
TURN=TURN-.5
CUT DOWN REST SIZE AND TRY AGAIN.
GO TO 11
10 L=-L
C FLIPFLOP
IF(L)GO TO 5
C NEXT BACKS UP
N=N-1
NN=NN-JBAR(N)
J=NN
K=N
GO TO 3
5 M=M+1
C MOVES AHEAD TO FIND RESTS
JJ=JJ+JBAR(M)
J=JJ
K=M
GO TO 3
4 KB=KB+1
IBAR(KB)=K
KB=KB+1
IBAR(KB)=100*MM
MM=2
C FIRST PAGE IS A SINGLE, DOUBLES AFTERWARD
NTOT=NTOT-J
CUT DOWN TOTAL SIZE TO LOOK AT
IF(NTOT.LE.250)GO TO 9
C 250 IS JLINE(IDEAL SIZE OF A LINE)
RPG=NTOT/250.+.5
LPG=RPG
AV=(NTOT/LPG)*2.
JP=RPG/(10.*RSTJ2)+.5
C JP= HOW MANY PAGES
P=LPG/JP
LT=K+1
GO TO 7
9 IBAR(1)=P
C JP IS NUM OF LINES/PAGE FOR NOW
KB=KB+1
TYPE 12,TURN
12 FORMAT(' TURN TIME UNIT =',F4.2)
END
SUBROUTINE BRJUGL(JBAR,KT,NBAR,MBAR,JRN,PGTRN,JTRN)
COMMON /BRJ/JTOT,TRN,NB,DSK /MNX/MIN,MAX,JT /Q/Q(1)
COMMON /FIN/LBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,NO1,LPG,MPG,CLEF,SIG,NO2,SPG,MTR1,MTR2
DIMENSION JBAR(1),NBAR(1),MBAR(1),JRN(1),PGTRN(1),JTRN(1)
NT=JT
L=0
KTOT=JTOT
KAV=JTOT/JT
LMIN=-1
LMAX=10000
LJ=0
NJ=0
LMM=-1
LDIF=10000
NBAR(1)=1
J=1
3 M=1
JAV=KTOT/NT
K=JBAR(J)
1 J=J+1
IF(J.GT.KT)GO TO 2
N=JBAR(J)
IF(K+N/2.GE.JAV)GO TO 2
M=M+1
K=K+N
GO TO 1
2 L=L+1
KTOT=KTOT-K
NT=NT-1
JRN(L)=K
NBAR(L+1)=J
IF(NT.GT.0)GO TO 3
5 MAX=0
MIN=10000
DO 7 L=1,JT
K=JRN(L)
IF(K.LE.MAX)GO TO 6
MAX=K
MX=L
6 IF(K.GE.MIN)GO TO 7
MIN=K
MN=L
7 CONTINUE
J=MAX-MIN
IF(MAX.GE.LMAX.AND.J.GE.LDIF)GO TO 9
IF(MIN.GT.LMIN)LMIN=MIN
IF(MAX.LT.LMAX)LMAX=MAX
IF(J.LT.LDIF)LDIF=J
CALL RLOOP(MBAR(2),NBAR(2),JT)
C SAVE NBAR INFO IN MBAR
IF(MX.LT.MN)GO TO 32
IF(MX.LE.1)GO TO 5
JJ=0
JM=-1
JK=1
23 K=NBAR(MX+JJ)-JJ
C NEXT RIPPLES THE BARS, FROM MAX TO MIN.
MM=JBAR(K)
JRN(MX)=JRN(MX)-MM
JMX=JM+MX
JRN(JMX)=JRN(JMX)+MM
NBAR(MX+JJ)=K+JK
MX=JMX
IF(JJ.NE.0)GO TO 223
IF(MX.GT.MN)GO TO 23
GO TO 5
223 IF(MX.LT.MN)GO TO 23
GO TO 5
32 JJ=1
JM=1
JK=0
GO TO 23
9 CALL GET(NBAR,JBAR,MBAR,JRN)
CC9 CALL GET
IDIF=10000
JJT=JT-1
104 CALL MNMX(IDIF,JRN)
108 DO 102 J=1,JJT
IF(JRN(J).LE.KAV)GO TO 102
C DON'T MAKE IT SMALLER IF IT'S ALREADY LESS THAN AVERAGE.
I=NBAR(J+1)-1
IF(I.EQ.NBAR(J))GO TO 102
C WE'RE DOWN TO ONE BAR
JJ=JRN(J)-JBAR(I)
C SUBTRACT LAST BAR OF THIS LINE, ADD IT ON NEXT.
IF(JJ.LT.MIN)GO TO 102
KK=JRN(J+1)+JBAR(I)
IF(KK.GT.MAX)GO TO 103
C LET'S SEE IF FURTHER SHUFFLING WILL IMPROVE IT.
CALL MINMAX(JRN)
105 JRN(J)=JJ
JRN(J+1)=KK
NBAR(J+1)=NBAR(J+1)-1
GO TO 104
103 IF(J.EQ.JJT)GO TO 102
NN=KK
DO 106 K=J+1,JJT
LL=NBAR(K+1)-1
C CHECK ON WHAT WILL HAPPEN TO NEXT LINE.
MM=NN-JBAR(LL)
IF(MM.LT.MIN.OR.MM.GT.MAX)GO TO 102
NN=JBAR(LL)+JRN(K+1)
106 IF(NN.LE.MAX)GO TO 105
102 CONTINUE
204 CALL MNMX(IDIF,JRN)
208 DO 202 J=JT,2,-1
IF(JRN(J).LE.KAV)GO TO 202
C DON'T MAKE IT SMALLER IF IT'S ALREADY LESS THAN AVERAGE.
I=NBAR(J)
IF(I-1.EQ.NBAR(J-1))GO TO 202
C WE'RE DOWN TO ONE BAR
JJ=JRN(J)-JBAR(I)
C SUBTRACT LAST BAR OF THIS LINE, ADD IT ON NEXT.
IF(JJ.LT.MIN)GO TO 202
KK=JRN(J-1)+JBAR(I)
IF(KK.GT.MAX)GO TO 203
C LET'S SEE IF FURTHER SHUFFLING WILL IMPROVE IT.
CALL MINMAX(JRN)
205 JRN(J)=JJ
JRN(J-1)=KK
NBAR(J)=NBAR(J)+1
GO TO 204
203 IF(J.EQ.2)GO TO 202
NN=KK
DO 206 K=J-1,2,-1
LL=NBAR(K)
C CHECK ON WHAT WILL HAPPEN TO NEXT LINE.
MM=NN-JBAR(LL)
IF(MM.LT.MIN.OR.MM.GT.MAX)GO TO 202
NN=JBAR(LL)+JRN(K-1)
206 IF(NN.LE.MAX)GO TO 205
202 CONTINUE
CALL MINMAX(JRN)
IDIF=MAX-MIN
CALL RLOOP(MBAR(2),NBAR(2),JT)
400 MX=MAX+5
JR=1
C JR = HOW MANY BARS TO RIPPLE
I=MAX-MIN
IF(I.GT.IDIF)GO TO 402
CALL RLOOP(MBAR(2),NBAR(2),JT)
IDIF=I
402 DO 401 J=1,JT
401 IF(JRN(J).EQ.MIN)GO TO 408
C TRY RIPPLE EACH WAY FROM SMALLEST VALUE
408 IF(J.EQ.JT)GO TO 508
C RIPPLE FORWARD FIRST
I=NBAR(J+1)
JJ=JRN(J)+JBAR(I)
IF(JJ.GT.MX)GO TO 508
C SMALLEST ISN'T TOO BIG, NOW CHECK UP THE LINE.
NN=JRN(J+1)-JBAR(I)
IF(NN.LT.MIN)GO TO 404
C IF WE GET HERE THERE HAS BEEN IMPROVEMENT
JRN(J)=JJ
JRN(J+1)=NN
NBAR(J+1)=I+1
415 CALL MINMAX(JRN)
C NOW GO BACK AND TRY AGAIN.
GO TO 400
405 JRN(J)=JJ
DO 422 IB=J+1,N
LB=NBAR(IB)
JB=JRN(IB)-JBAR(LB)
NBAR(IB)=LB+1
IF(JB.LT.MIN)GO TO 421
JRN(IB)=JB
GO TO 415
421 IBB=IB+1
LC=NBAR(IBB)
JB=JB+JBAR(LC)
IF(JB.GT.MIN)GO TO 422
C NOW ADD A SECOND BAR
JRN(IBB)=JRN(IBB)-JBAR(LC)
LC=LC+1
JB=JB+JBAR(LC)
NBAR(IBB)=LC
422 JRN(IB)=JB
NBAR(IBB)=LC+1
JRN(IBB)=JRN(IBB)-JBAR(LC)
GO TO 415
C NOW GO BACK AND TRY AGAIN.
404 IF(J.EQ.JJT)GO TO 508
DO 406 N=J+1,JJT
LL=NBAR(N+1)
MM=NN+JBAR(LL)
IF(MM.GT.MX)GO TO 508
IF(MM.GT.MIN)GO TO 409
C NEXT TO RIPPLE 2 BARS!
412 MN=MM+JBAR(LL+1)
C ADD ON A SECOND BAR
IF(MN.GT.MX)GO TO 508
C DON'T WORRY ABOUT IT BEING TOO SMALL (YET)
NN=JRN(N+1)-JBAR(LL)-JBAR(LL+1)
IF(NN.GT.MIN)GO TO 405
GO TO 406
409 NN=JRN(N+1)-JBAR(LL)
IF(NN.GE.MIN)GO TO 405
406 CONTINUE
C TRY RIPPLE EACH WAY FROM SMALLEST VALUE
508 IF(J.EQ.1)GO TO 502
IF(J.EQ.LJ.AND.MX-MN.EQ.LMM)GO TO 502
IF(JDIF.EQ.IDIF)GO TO 150
ICNT=0
GO TO 151
150 ICNT=ICNT+1
IF(ICNT.EQ.10)GO TO 515
151 JDIF=IDIF
C THIS SHOULD AVOID GETTING INTO A LOOP
LJ=J
LMM=MX-MN
C RIPPLE BACK NOW
I=NBAR(J)-1
JJ=JRN(J)+JBAR(I)
IF(JJ.GT.MX)GO TO 502
C SMALLEST ISN'T TOO BIG, NOW CHECK UP THE LINE.
NN=JRN(J-1)-JBAR(I)
IF(NN.LT.MIN)GO TO 504
C IF WE GET HERE THERE HAS BEEN IMPROVEMENT
JRN(J)=JJ
JRN(J-1)=NN
NBAR(J)=I
GO TO 415
505 JRN(J)=JJ
DO 522 IB=J-1,N,-1
LB=NBAR(IB+1)-1
JB=JRN(IB)-JBAR(LB)
NBAR(IB+1)=LB
IF(JB.LT.MIN)GO TO 521
JRN(IB)=JB
GO TO 415
521 IBB=IB-1
LC=NBAR(IB)-1
JB=JB+JBAR(LC)
IF(JB.GT.MIN)GO TO 522
JB=JB+JBAR(LC-1)
NBAR(IB)=LC
JRN(IBB)=JRN(IBB)-JBAR(LC)
CHECK THIS OUT!!
LC=LC-1
522 JRN(IB)=JB
JRN(IBB)=JRN(IBB)-JBAR(LC)
NBAR(IB)=LC
GO TO 415
504 IF(J.LE.2)GO TO 502
DO 506 N=J-1,2,-1
LL=NBAR(N)-1
MM=NN+JBAR(LL)
IF(MM.GT.MX)GO TO 502
IF(MM.GT.MIN)GO TO 509
512 MN=MM+JBAR(LL-1)
IF(MN.GT.MX)GO TO 502
NN=JRN(N-1)-JBAR(LL)-JBAR(LL-1)
IF(NN.GT.MIN)GO TO 505
GO TO 506
509 NN=JRN(N-1)-JBAR(LL)
IF(NN.GE.MIN)GO TO 505
506 CONTINUE
502 IF(J.EQ.NJ.AND.MX-MN.EQ.LMM)GO TO 515
C CHECK TO AVOID ENDLESS LOOP.
NJ=J
IF(J.EQ.JT)GO TO 515
C LOOK FOR OTHER LINES = MIN.
DO 510 K=J+1,JT
IF(JRN(K).NE.MIN)GO TO 510
J=K
GO TO 408
510 CONTINUE
515 CALL GET(NBAR,JBAR,MBAR,JRN)
CC515 CALL GET
13 DO 14 L=2,JT
K=NBAR(L)
MM=JRN(L)
KK=JRN(L-1)
IF(MM.GE.KK)GO TO 12
C JUGGLES ADJACENT LINES
N=JBAR(K-1)
IF(KK-MM.LT.N)GO TO 14
JRN(L-1)=KK-N
JRN(L)=MM+N
NBAR(L)=K-1
GO TO 13
12 N=JBAR(K)
IF(MM-KK.LE.N)GO TO 14
JRN(L-1)=KK+N
JRN(L)=MM-N
NBAR(L)=K+1
GO TO 13
14 CONTINUE
46 J=1
NBAR(JT+1)=KT+1
JAV=JTOT/JT
CALL MINMAX(JRN)
308 FORMAT(' AVG=',I3,' MIN=',I3,' MAX=',I3)
TYPE 308,JAV,MIN,MAX
IF(DSK)WRITE(21,308)JAV,MIN,MAX
307 DO 310 K=1,NBAR(JT+1)-1
L=JBAR(K)
IF(PGTRN(K).GE.TRN)L=-L
310 JTRN(K)=L
C ABOVE MAKES NEG. BAR VALUES WHERE TURNS ARE POSSIBLE.
LJ=0
306 FORMAT(I5,' (',I3,')',3X50I5)
309 DO 305 K=1,JT
LJ=LJ+1
NBAR(K)=NBAR(K+1)-NBAR(K)
C NBAR NOW HAS NUM. OF BARS PER LINE.
L=NBAR(K)-1+J
MM=NB+J-1
TYPE 306,JRN(K),MM,(JTRN(N),N=J,L)
IF(DSK)WRITE(21,306)JRN(K),MM,(JTRN(N),N=J,L)
IF(LJ.LT.MPG)GO TO 305
LJ=0
IF(DSK)WRITE(21,3066)
TYPE 3066
3066 FORMAT(' ************')
305 J=L+1
NBAR(JT+1)=0
END
SUBROUTINE GET(NBAR,JBAR,MBAR,JRN)
COMMON /MNX/MIN,MAX,JT
DIMENSION MBAR(1),JBAR(1),JRN(1),NBAR(1)
J=1
DO 1 K=2,JT+1
NBAR(K)=MBAR(K)
N=0
DO 2 L=J,MBAR(K)-1
C FIX UP JRN ARRAY
2 N=N+JBAR(L)
JRN(K-1)=N
1 J=MBAR(K)
END
CC SUBROUTINE MNMX(IDIF,JRN)
CC COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
CC L=MIN
CC N=MAX
CC CALL MINMAX(JRN)
CC J=MAX-MIN
CC IF(J.LE.IDIF)GO TO 1
CC MIN=L
CC MAX=N
CC RETURN
CC1 IDIF=J
CC END
***** Arrow at Line 12 of 543 ***** Page 2 of 2 ***** 18R +366C *****